home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
Yerk 3.64
/
Asm source
/
ic1
< prev
next >
Wrap
Text File
|
1990-12-22
|
8KB
|
431 lines
\ Instruction Classes Reese Warner 3/85
\ 8/85 RW added comments
\ 8/85 RW Added Yerk mode
\ 9/85 RW Added type 26, sized single ea instruction
\ 9/85 RW Added type27, for the STOP instruction
\ 12/85 JF Fixed LENGTH: method on TYPE3
\ 03/07/86 GDC Fixed type 7 BUILD:
\ 7/10/86 mrh Fixed type 6, for short branches
0 -> dlevel
:CLASS machInst <super object
var bytecode
int srcMask
int dstMask
int theSize
:M INIT: { opcode -- }
opcode put: bytecode
hex
@word number drop put: srcMask \ reads sourcemask
@word number drop put: dstMask \ reads destination mask
@word number drop put: theSize \ reads the machine code size
decimal
;M
:M BC: \ debug
binary get: bytecode ." bytecode is " u. cr decimal
;M
:M MASKS: \ debug
hex get: srcMask ." src is " u. cr
get: dstMask ." dst is " u. cr
;M
:M OPSIZE:
get: theSize
;M
;CLASS
\ TYPE1 - No operand instructions, such as Reset, Stop, etc.
:CLASS type1 <super machInst
:M BUILD:
get: bytecode w,
;M
:M LENGTH: ( -- len )
1
;M
;CLASS
\ TYPE2 - Register, immediate value, such as Link
\ e.g. Link A0,#100
:CLASS type2 <super machInst
:M BUILD: { \ workSpace -- }
op1 getOp
get: bytecode -> workSpace
workSpace reg: op1 or w,
op2 getOp
value: op2 w,
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
2
;M
;CLASS
\ TYPE3 - Instructions that take an immediate operand, such as ANDI, EORI
\ e.g. EORI.W #100,-(A4)
:CLASS type3 <super machInst
:M BUILD: { \ workSpace -- }
op1 getOp
op2 getOp
get: bytecode -> workSpace
opSize 6 << workSpace or -> workSpace
ea: op2 workspace or -> workSpace
workSpace w,
value: op1 \ immediate Data
opSize 2 =
IF
,
ELSE
w,
THEN
op2 compIdxMode
;M
:M LENGTH: { \ size -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
2 -> size \ 1 -> 2 jaf 12/17
op2 modeSize ++> size
opSize 1- 0 max ++> size \ '1 max' -> '1- 0 max' jaf 12/17
size
;M
;CLASS
\ TYPE4 - Instructions that take a reg, an effective Addr, an opmode
\ e.g. OR.L d0,(SP), ADD
:CLASS type4 <super machInst
:M BUILD: { \ opMode Reg EA workSpace flag -- }
op1 getOp
op2 getOp
true -> flag
mode: op2 1 =
IF
opSize 2 =
IF
7 -> opMode
ELSE
3 -> opMode
THEN
reg: op2 -> reg
ea: op1 -> ea
false -> flag
THEN
mode: op2 0= flag and
IF
opSize -> opMode
reg: op2 -> reg
ea: op1 -> ea
false -> flag
THEN
mode: op1 0= flag and
IF
opSize 4+ -> opMode
reg: op1 -> reg
ea: op2 -> ea
false -> flag
THEN
flag
IF
219 asmERROR \ at least one operand must be a register direct
THEN
get: bytecode -> workSpace
reg 9 << workSpace or -> workspace
opMode 6 << workSpace or -> workSpace
ea workSpace or -> workSpace
workSpace w,
op1 compIdxMode
op2 compIdxMode
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: srcMask check
1 -> len
op1 modesize ++> len
op2 modesize ++> len
len
;M
;CLASS
\ TYPE5 - reg & ea, unsized e.g. LEA -(A4),A3
:CLASS type5 <super machInst
:M BUILD: { \ workSpace -- }
op1 getOp
op2 getOp
get: bytecode -> workSpace
reg: op2 9 << workSpace or -> workSpace
ea: op1 workSpace or -> workSpace
workSpace w,
op1 compIdxMode
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1 op1 modeSize +
;M
;CLASS
\ TYPE6 - Branch Instructions
\ e.g. BNE aLabel
:CLASS type6 <super machInst
:M BUILD:
op1 getOp
get: bytecode value: op1
opSize 0=
IF dup 127 > over -128 < or
IF 250 asmerror THEN $ ff and or
ELSE swap w,
THEN w,
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
opSize IF 2 ELSE 1 THEN
;M
;CLASS
\ TYPE7 - Bit test operations: BCLR,BSET,BTST,BCHG
\ e.g. BTST D5,-(A4) or BTST #5,-(A4)
:CLASS type7 <super machInst
:M BUILD: { \ workSpace -- }
op1 getOp
op2 getOp
get: bytecode -> workSpace
mode: op1 0=
IF
reg: op1 9 << workSPace or -> workSpace
ea: op2 workSpace or -> workSpace
256 workspace or -> workspace
workSpace w,
ELSE
ea: op2 workSpace or -> workSpace
2048 workspace or -> workSpace
workSpace w,
value: op1 w,
THEN
op2 compIdxMode
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
mode: op1 0=
IF
1 -> len
ELSE
2 -> len
THEN
len
;M
;CLASS
\ TYPE8 - single ea instructions. E.G. PEA aLabel
:CLASS type8 <super machInst
:M BUILD:
op1 getOp
get: bytecode ea: op1 or w,
op1 compIdxMode
;M
:M LENGTH: { \ len - len }
op1 getOp
op1 get: srcMask check
1 -> len
op1 modeSize ++> len
len
;M
;CLASS
\ TYPE9 - EXG A2,D4
:CLASS type9 <super machInst
:M BUILD: { \ work -- }
op1 getOp
op2 getOp
get: bytecode -> work
reg: op1 9 << work or -> work
reg: op2 work or -> work
mode: op1 0= mode: op2 0= and
IF
64 work or -> work
THEN
mode: op1 0= mode: op2 1 = and mode: op1 1 = mode: op2 0= and or
IF
72 work or -> work
THEN
mode: op1 1 = mode: op2 1 = and
IF
136 work or -> work
THEN
work w,
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1
;M
;CLASS
\ TYPE10 - EXT.L DO
:CLASS type10 <super machInst
:M BUILD: { \ work -- }
op1 getOp
get: bytecode -> work
reg: op1 work or -> work
opSize 1+ 2 max 6 << work or -> work \ set opMode field
work w,
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
1
;M
;CLASS
\ TYPE11 - Shift operations e.g. LSL.W #2,D0
:CLASS type11 <super machInst
:M BUILD: { \ work val -- }
op1 getOp
get: bytecode -> work
mode: op1 11 = mode: op1 0= or
IF
opSize 6 << work or -> work
op2 getOp
mode: op1 0=
IF
32 work or -> work
reg: op1 9 << work or -> work
ELSE
value: op1 -> val
val 8 mod -> val
val 9 << work or -> work
THEN
reg: op2 work or -> work
work w,
ELSE
192 work or -> work
ea: op1 work or w,
op1 compIdxMode
THEN
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
mode: op1 11 = mode: op1 0= or
IF
op2 getOp
op2 get: dstMask check
1 -> len
ELSE
1 op1 modeSize + -> len
THEN
len
;M
;CLASS
\ TYPE12 - ADDQ, SUBQ
\ e.g. ADDQ.L #4,D6
:CLASS type12 <super machInst
:M BUILD: { \ work -- }
op1 getOp
op2 getOp
get: bytecode -> work
value: op1 8 mod 9 << work or -> work
opSize 6 << work or -> work
ea: op2 work or -> work
work w,
op2 compIdxMode
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1 op2 modeSize +
;M
;CLASS
\ TYPE13 - ABCD, SBCD
\ e.g. ABCD D1,D2 or ABCD -(A4),-(A3)
:CLASS type13 <super machInst
:M BUILD: { \ work -- }
op1 getOp
op2 getOp
get: bytecode -> work
reg: op1 work or -> work
reg: op2 9 << work or -> work
mode: op1 0= not
IF
8 ++> work
THEN
work w,
;M
:M LENGTH: { \ len -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
mode: op1 mode: op2 = not
IF
207 asmError
THEN
1 -> len
op1 modesize ++> len
op2 modesize ++> len
len
;M
;CLASS